home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
jpi
/
gameinte.bas
< prev
next >
Wrap
BASIC Source File
|
1998-01-29
|
23KB
|
599 lines
Attribute VB_Name = "GameInterface"
Global Const EXTRABORDER = 5
Global Const MouseDragThreshhold = 4
Global Const MAXMOUSEBUTTONS = 5
'Mouse
Type MousePoint
DragStartPosition As Point3D
DragCurrentPosition As Point3D
IsDragging As Boolean
Position As Point3D
OldButtonStates(1 To MAXMOUSEBUTTONS) As Boolean
ButtonStates(1 To MAXMOUSEBUTTONS) As Boolean
CursorPic As Integer
End Type
Public Mouse As MousePoint
'Keyboard
Global Const KEY_SHIFT = 16
Global Const KEY_ENTER = 13
Global Const KEY_ESCAPE = 27
Global Const KEY_T = 84
Global Const KEY_S = 83
Global Const KEY_D = 68
Global Const KEY_CONTROL = 17
Global Const KEY_ALT = 18
Global Const KEY_TAB = 9
Global Const KEY_UP = 38
Global Const KEY_DOWN = 40
Global Const KEY_LEFT = 37
Global Const KEY_RIGHT = 39
Global KeyStates(250) As Boolean
Type ObjectSelect
MaxSelected As Integer
SelectedList(MAXOBJECTS) As Integer
End Type
Type Interflags
WritingAMessage As Boolean
Message As String
PlacingABuilding As Boolean
PlaceIndex As Integer
End Type
Global InterfaceFlags As Interflags
Global ObjectSelectedList As IndexGroup
'Real stuff
Public Const INTERFACEWIDTH = 320
Public Const INTERFACEHEIGHT = 200
Public Const HALFINTERFACEWIDTH = INTERFACEWIDTH / 2
Public Const HALFINTERFACEHEIGHT = INTERFACEHEIGHT / 2
Private Const NOCONTROL = 0
Private Const MAXPROPERTIES = 10
Public Const CONTROLPROPERTY_TEXT = 1
Public Const CONTROLPROPERTY_PICTURE = 2
Public Const CONTROLPROPERTY_STATE = 3
Type PropertyArray
Properties(MAXPROPERTIES) As Variant
End Type
Type ControlObject
Outline As RECT
ControlProperties As PropertyArray
ControlType As Integer
End Type
Private Const MAXCONTROLAMOUNT = 30
Type ControlGroup
ControlAmount As Integer
ControlObjects(MAXCONTROLAMOUNT) As ControlObject
End Type
Type InterfaceReturnObj
Controls As ControlGroup
Canceled As Boolean
End Type
Type InterfaceObj
BackgroundPic As Integer
BackgroundSound As String
MouseCursorPic As Integer
Controls As ControlGroup
ControlFocus As Integer
End Type
Public Const CONTROLTYPE_PICTUREBOX = 1
Public Const CONTROLTYPE_BUTTONLARGE = 2
Public Const CONTROLTYPE_LABEL = 3
Public Const CONTROLTYPE_TEXTBOX = 4
Public Function CreateControl(ControlType, X, Y, Width, Height, Content) As ControlObject
Dim NewControl As ControlObject
NewControl.ControlType = ControlType
Select Case ControlType
Case CONTROLTYPE_PICTUREBOX
NewControl.ControlProperties.Properties(CONTROLPROPERTY_PICTURE) = Content
NewControl.Outline.Top = Y - Int(Height / 2)
NewControl.Outline.bottom = Y + Int(Height / 2)
NewControl.Outline.Left = X - Int(Width / 2)
NewControl.Outline.Right = X + Int(Width / 2)
Case CONTROLTYPE_BUTTONLARGE
NewControl.ControlProperties.Properties(CONTROLPROPERTY_TEXT) = Content
NewControl.ControlProperties.Properties(CONTROLPROPERTY_STATE) = False
NewControl.Outline.Top = Y
NewControl.Outline.bottom = Y + Height
NewControl.Outline.Left = X
NewControl.Outline.Right = X + Width
Case CONTROLTYPE_LABEL
NewControl.ControlProperties.Properties(CONTROLPROPERTY_TEXT) = Content
NewControl.Outline.Top = Y
NewControl.Outline.bottom = Y + Height
NewControl.Outline.Left = X
NewControl.Outline.Right = X + Width
Case CONTROLTYPE_TEXTBOX
NewControl.ControlProperties.Properties(CONTROLPROPERTY_TEXT) = Content
NewControl.Outline.Top = Y - Int((Height * FONT_SPACINGY) / 2)
NewControl.Outline.bottom = Y + Int((Height * FONT_SPACINGY) / 2)
NewControl.Outline.Left = X - Int((Width * FONT_SPACINGX) / 2)
NewControl.Outline.Right = X + Int((Width * FONT_SPACINGX) / 2)
End Select
CreateControl = NewControl
End Function
Public Function ProjectRectToCenterScreen(RectToConvert As RECT) As RECT
ProjectRectToCenterScreen.Left = (RectToConvert.Left - HALFINTERFACEWIDTH) + ResolutionMidX
ProjectRectToCenterScreen.Right = (RectToConvert.Right - HALFINTERFACEWIDTH) + ResolutionMidX
ProjectRectToCenterScreen.Top = (RectToConvert.Top - HALFINTERFACEHEIGHT) + ResolutionMidY
ProjectRectToCenterScreen.bottom = (RectToConvert.bottom - HALFINTERFACEHEIGHT) + ResolutionMidY
End Function
Private Sub DrawInterface(Interface As InterfaceObj)
Call GraphicsEngine.SplashGraphic(InGameConstants(InGameConstant_PICINDEX_ProgramBackground))
Call GraphicsEngine.DisplayText("JPI v" & VERSION, ResolutionMidX - HALFINTERFACEWIDTH, ResolutionMidY - HALFINTERFACEHEIGHT, PALLETE_YELLOW)
For I = 1 To Interface.Controls.ControlAmount
'Display controls
With Interface.Controls.ControlObjects(I)
Select Case .ControlType
Case CONTROLTYPE_PICTUREBOX
Call GraphicsEngine.PutGraphicOntoBackBuffer(.Outline.Left + Pics(.ControlProperties.Properties(CONTROLPROPERTY_PICTURE)).HalfWidth, .Outline.Top + Pics(.ControlProperties.Properties(CONTROLPROPERTY_PICTURE)).HalfHeight, .ControlProperties.Properties(CONTROLPROPERTY_PICTURE), BltType_Mask)
Case CONTROLTYPE_BUTTONLARGE
Call GraphicsEngine.PutGraphicOntoBackBuffer(.Outline.Left + Pics(InGameConstants(InGameConstant_PICINDEX_ButtonLarge)).HalfWidth, .Outline.Top + Pics(InGameConstants(InGameConstant_PICINDEX_ButtonLarge)).HalfHeight, InGameConstants(InGameConstant_PICINDEX_ButtonLarge), BltType_Fast)
Call GraphicsEngine.DisplayTextCenterRelative(.ControlProperties.Properties(CONTROLPROPERTY_TEXT), .Outline.Left + 70, .Outline.Top + 6, PALLETE_WHITE)
Case CONTROLTYPE_TEXTBOX
Call GraphicsEngine.DisplayText(.ControlProperties.Properties(CONTROLPROPERTY_TEXT), .Outline.Left, .Outline.Top + 1, PALLETE_YELLOW)
Call GraphicsEngine.GethDC
Call GraphicsEngine.DrawBox(.Outline.Left, .Outline.Top + 2, .Outline.Right, .Outline.bottom - 1, 255, 255, 255, 0, 0, 0, LINEMODE_NORMAL)
Call GraphicsEngine.ReleasehDC
Case CONTROLTYPE_LABEL
Call GraphicsEngine.DisplayTextCenterRelative(.ControlProperties.Properties(CONTROLPROPERTY_TEXT), .Outline.Left + ((.Outline.Right - .Outline.Left) / 2), .Outline.Top + ((.Outline.bottom - .Outline.Top) / 2), PALLETE_YELLOW)
End Select
End With
Next I
End Sub
Public Function RunStaticInterface(InterfaceToRun As InterfaceObj) As InterfaceReturnObj
Dim InterfaceReturn As InterfaceReturnObj, Interface As InterfaceObj
ViewForm.KeyboardInputBox.Text = ""
Interface = InitializeInterfaceObj(InterfaceToRun)
Call ClearKeyStates
If InterfaceToRun.BackgroundSound <> "" Then Call Sound.Play_LoopSound(Sound.GetSoundIndex(InterfaceToRun.BackgroundSound), 100)
Do
DoEvents
If Interface.ControlFocus <> NOCONTROL Then
If RunControlKeyboardInput(Interface.Controls.ControlObjects(Interface.ControlFocus)) = True Then
Interface.ControlFocus = NOCONTROL
End If
End If
For I = 1 To Interface.Controls.ControlAmount
If RunControlMouseInput(Interface.Controls.ControlObjects(I)) = True Then
Select Case Interface.Controls.ControlObjects(I).ControlType
Case CONTROLTYPE_TEXTBOX
Interface.ControlFocus = I
ViewForm.KeyboardInputBox.Text = Interface.Controls.ControlObjects(I).ControlProperties.Properties(CONTROLPROPERTY_TEXT)
ViewForm.KeyboardInputBox.SelStart = Len(ViewForm.KeyboardInputBox.Text)
ViewForm.KeyboardInputBox.MaxLength = (Interface.Controls.ControlObjects(I).Outline.Right - Interface.Controls.ControlObjects(I).Outline.Left) / FONT_SPACINGX
End Select
If Interface.Controls.ControlObjects(I).ControlType = CONTROLTYPE_BUTTONLARGE Then
Exit Do
End If
End If
Next I
Call GraphicsEngine.ClearBackBuffer
Call DrawInterface(Interface)
GraphicsEngine.SwapScreen
'Display mouse cursor (make a sub DisplayMousecursor(CursorPic)
If KeyStates(KEY_ESCAPE) = True Then
RunStaticInterface.Canceled = True
Exit Do
End If
Loop
Call Sound.Stop_Sounds
RunStaticInterface.Controls = Interface.Controls
ViewForm.KeyboardInputBox.MaxLength = 0
End Function
Public Sub RunImmediateInterface(Interface As InterfaceObj)
For I = 1 To Interface.Controls.ControlAmount
' Call RunControl(Interface.Controls.ControlObjects(I))
Nex